home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / EAGUI / EASupport.mod < prev    next >
Text File  |  1995-06-29  |  9KB  |  334 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: EASupport.mod $
  4.   Description: Support for clients of EAGUI.library
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.2 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:20:03 $
  10.  
  11.   Copyright © 1995, Frank Copeland.
  12.   This file is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18. <*$ StackChk- *>
  19. <*$ LongVars+ *>
  20.  
  21. MODULE EASupport;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, e := Exec, u := Utility, gfx := Graphics, i := Intuition,
  25.   gt := GadTools, ea := EAGUI;
  26.  
  27. (*------------------------------------*)
  28. VAR
  29.  
  30.   SameSizeHook*,
  31.   SameHeightHook*,
  32.   SameWidthHook*
  33.     : u.HookPtr;
  34.  
  35.   hook1, hook2, hook3 : u.Hook;
  36.  
  37. (*------------------------------------*)
  38. (* same size relation *)
  39.  
  40. PROCEDURE SameSize*
  41.   ( hook : u.HookPtr;
  42.     list : e.ListPtr;
  43.     msg  : e.APTR )
  44.   : e.ULONG;
  45.  
  46.   VAR
  47.     ro : ea.RelationObjectPtr;
  48.     minx, miny, x, y, ignore : e.ULONG;
  49.  
  50.   BEGIN (* SameSize *)
  51.     minx := 0;
  52.     miny := 0;
  53.  
  54.     (* examine the list of objects that are affected by the relation *)
  55.     ro := SYS.VAL (ea.RelationObjectPtr, list.head);
  56.     WHILE ro.node.succ # NIL DO
  57.       ignore := ea.GetAttrs ( ro.object_ptr,
  58.                               ea.MinWidth,  SYS.ADR (x),
  59.                               ea.MinHeight, SYS.ADR (y),
  60.                               u.done );
  61.  
  62.       (* find the maximum values of the minimum sizes *)
  63.       IF x > minx THEN minx := x END;
  64.       IF y > miny THEN miny := y END;
  65.  
  66.       ro := SYS.VAL (ea.RelationObjectPtr, ro.node.succ)
  67.     END;
  68.  
  69.     (* set all objects to the newly found minimum sizes *)
  70.     ro := SYS.VAL (ea.RelationObjectPtr, list.head);
  71.     WHILE ro.node.succ # NIL DO
  72.       ignore := ea.SetAttrs ( ro.object_ptr,
  73.                               ea.MinWidth,  minx,
  74.                               ea.MinHeight, miny,
  75.                               u.done );
  76.  
  77.       ro := SYS.VAL (ea.RelationObjectPtr, ro.node.succ)
  78.     END;
  79.     RETURN 0
  80.   END SameSize;
  81.  
  82. (*------------------------------------*)
  83. (* same width relation *)
  84.  
  85. PROCEDURE SameWidth*
  86.   ( hook : u.HookPtr;
  87.     list : e.ListPtr;
  88.     msg  : e.APTR )
  89.   : e.ULONG;
  90.  
  91.   VAR
  92.     ro : ea.RelationObjectPtr;
  93.     minx, x, ignore : e.ULONG;
  94.  
  95.   BEGIN (* SameWidth *)
  96.     minx := 0;
  97.  
  98.     (* examine the list of objects that are affected by the relation *)
  99.     ro := SYS.VAL (ea.RelationObjectPtr, list.head);
  100.     WHILE ro.node.succ # NIL DO
  101.       ignore := ea.GetAttrs ( ro.object_ptr,
  102.                               ea.MinWidth,  SYS.ADR (x),
  103.                               u.done );
  104.  
  105.       (* find the maximum values of the minimum sizes *)
  106.       IF x > minx THEN minx := x END;
  107.  
  108.       ro := SYS.VAL (ea.RelationObjectPtr, ro.node.succ)
  109.     END;
  110.  
  111.     (* set all objects to the newly found minimum sizes *)
  112.     ro := SYS.VAL (ea.RelationObjectPtr, list.head);
  113.     WHILE ro.node.succ # NIL DO
  114.       ignore := ea.SetAttrs ( ro.object_ptr,
  115.                               ea.MinWidth,  minx,
  116.                               u.done );
  117.  
  118.       ro := SYS.VAL (ea.RelationObjectPtr, ro.node.succ)
  119.     END;
  120.     RETURN 0
  121.   END SameWidth;
  122.  
  123. (*------------------------------------*)
  124. (* same height relation *)
  125.  
  126. PROCEDURE SameHeight*
  127.   ( hook : u.HookPtr;
  128.     list : e.ListPtr;
  129.     msg  : e.APTR )
  130.   : e.ULONG;
  131.  
  132.   VAR
  133.     ro : ea.RelationObjectPtr;
  134.     miny, y, ignore : e.ULONG;
  135.  
  136.   BEGIN (* SameHeight *)
  137.     miny := 0;
  138.  
  139.     (* examine the list of objects that are affected by the relation *)
  140.     ro := SYS.VAL (ea.RelationObjectPtr, list.head);
  141.     WHILE ro.node.succ # NIL DO
  142.       ignore := ea.GetAttrs ( ro.object_ptr,
  143.                               ea.MinHeight, SYS.ADR (y),
  144.                               u.done );
  145.  
  146.       (* find the maximum values of the minimum sizes *)
  147.       IF y > miny THEN miny := y END;
  148.  
  149.       ro := SYS.VAL (ea.RelationObjectPtr, ro.node.succ)
  150.     END;
  151.  
  152.     (* set all objects to the newly found minimum sizes *)
  153.     ro := SYS.VAL (ea.RelationObjectPtr, list.head);
  154.     WHILE ro.node.succ # NIL DO
  155.       ignore := ea.SetAttrs ( ro.object_ptr,
  156.                               ea.MinHeight, miny,
  157.                               u.done );
  158.  
  159.       ro := SYS.VAL (ea.RelationObjectPtr, ro.node.succ)
  160.     END;
  161.     RETURN 0
  162.   END SameHeight;
  163.  
  164.  
  165. (*------------------------------------*)
  166. PROCEDURE HandleSizeVerify*
  167.   ( win         : i.WindowPtr;
  168.     winObj      : ea.OPTR;
  169.     VAR gadList : i.GadgetPtr );
  170.  
  171.   VAR ignore : LONGINT;
  172.  
  173.   BEGIN (* HandleSizeVerify *)
  174.     IF gadList # NIL THEN
  175.       ignore := i.RemoveGList ( win, gadList, -1 );
  176.       ea.FreeGadgetList ( winObj, gadList );
  177.       gadList := NIL
  178.     END
  179.   END HandleSizeVerify;
  180.  
  181.  
  182. (*------------------------------------*)
  183. PROCEDURE DoRender*
  184.   ( win         : i.WindowPtr;
  185.     winObj      : ea.OPTR;
  186.     VAR gadList : i.GadgetPtr;
  187.     drawInfo    : i.DrawInfoPtr;
  188.     visualInfo  : gt.VisualInfo );
  189.  
  190.   VAR
  191.     bl, br, bt, bb, ignore : LONGINT;
  192.  
  193.   BEGIN (* DoRender *)
  194.     ignore := ea.GetAttrs ( winObj,
  195.         ea.BorderLeft,   SYS.ADR (bl),
  196.         ea.BorderRight,  SYS.ADR (br),
  197.         ea.BorderTop,    SYS.ADR (bt),
  198.         ea.BorderBottom, SYS.ADR (bb),
  199.         u.done );
  200.  
  201.     ignore := ea.SetAttrs ( winObj,
  202.         ea.Width,  win.width -
  203.                    win.borderLeft -
  204.                    win.borderRight -
  205.                    bl - br,
  206.         ea.Height, win.height -
  207.                    win.borderTop -
  208.                    win.borderBottom -
  209.                    bt - bb,
  210.         ea.Left,   win.borderLeft,
  211.         ea.Top,    win.borderTop,
  212.         u.done );
  213.  
  214.     ea.LayoutObjects ( winObj );
  215.  
  216.     IF ea.CreateGadgetList ( winObj, gadList, visualInfo, drawInfo )
  217.      # ea.ERROR_OK
  218.     THEN
  219.       HALT (98)
  220.     END;
  221.  
  222.     gfx.EraseRect ( win.rPort,
  223.         win.borderLeft,
  224.         win.borderTop,
  225.         win.width - win.borderRight - 1,
  226.         win.height - win.borderBottom - 1 );
  227.  
  228.     i.RefreshWindowFrame ( win );
  229.  
  230.     ignore := i.AddGList ( win, gadList, -1, -1, NIL );
  231.     i.RefreshGList ( gadList, win, NIL, -1 );
  232.     gt.RefreshWindow ( win, NIL );
  233.  
  234.     (* finally, we render the imagery, if there is any *)
  235.     ea.RenderObjects ( winObj, win.rPort );
  236.   END DoRender;
  237.  
  238.  
  239. (*------------------------------------*)
  240. PROCEDURE OpenWindow*
  241.   ( scrType        : u.TagID;
  242.     scr            : i.ScreenPtr;
  243.     winTitle       : e.LSTRPTR;
  244.     winObj         : ea.OPTR;
  245.     VAR win        : i.WindowPtr );
  246.  
  247.   VAR
  248.     w, h, bl, br, bt, bb, ignore : LONGINT;
  249.     wPtr, hPtr, blPtr, brPtr, btPtr, bbPtr : SYS.ADDRESS;
  250.  
  251.   BEGIN (* OpenWindow *)
  252.     (* obtain the minimum dimensions of every object in the tree *)
  253.     ea.GetMinSizes ( winObj );
  254.  
  255.     (* get some attributes *)
  256.     wPtr := SYS.ADR (w); hPtr := SYS.ADR (h);
  257.     blPtr := SYS.ADR (bl); brPtr := SYS.ADR (br);
  258.     btPtr := SYS.ADR (bt); bbPtr := SYS.ADR (bb);
  259.  
  260.     ignore := ea.GetAttrs ( winObj,
  261.         ea.MinWidth,     wPtr,
  262.         ea.MinHeight,    hPtr,
  263.         ea.BorderLeft,   blPtr,
  264.         ea.BorderRight,  brPtr,
  265.         ea.BorderTop,    btPtr,
  266.         ea.BorderBottom, bbPtr,
  267.         u.done );
  268.  
  269.      (* open the window *)
  270.      win := i.OpenWindowTagsA ( NIL,
  271.          i.waTitle,       winTitle,
  272.          i.waFlags,       { i.windowDrag, i.windowDepth, i.windowClose,
  273.                             i.windowSizing, i.sizeBBottom, i.activate },
  274.          i.waIDCMP,       { i.closeWindow, i.refreshWindow, i.newSize }
  275.                           + gt.buttonIDCMP + gt.stringIDCMP,
  276.          i.waInnerHeight, h + bt + bb,
  277.          i.waInnerWidth,  (w + bl + br) * 2,
  278.          scrType,         scr,
  279.          u.done );
  280.      ASSERT (win # NIL, 98);
  281.  
  282.      (* set the window limits *)
  283.      IF i.WindowLimits ( win,
  284.          w + win.borderLeft + win.borderRight + bl + br,
  285.          h + win.borderTop + win.borderBottom + bt + bb,
  286.          -1, -1 )
  287.      THEN END;
  288.   END OpenWindow;
  289.  
  290.  
  291. (*------------------------------------*)
  292. PROCEDURE CloseWindow*
  293.   ( VAR win        : i.WindowPtr;
  294.     VAR winObj     : ea.OPTR;
  295.     VAR gadList    : i.GadgetPtr );
  296.  
  297.   VAR ignore : LONGINT;
  298.  
  299.   BEGIN (* CloseWindow *)
  300.     IF gadList # NIL THEN
  301.       ignore := i.RemoveGList ( win, gadList, -1 );
  302.       ea.FreeGadgetList ( winObj, gadList );
  303.       gadList := NIL
  304.     END;
  305.  
  306.     IF win # NIL THEN
  307.       i.CloseWindow ( win );
  308.       win := NIL
  309.     END;
  310.  
  311.     IF winObj # NIL THEN
  312.       ea.DisposeObject ( winObj );
  313.       winObj := NIL
  314.     END
  315.   END CloseWindow;
  316.  
  317. (*------------------------------------*)
  318. PROCEDURE Init ();
  319.  
  320.   BEGIN (* Init *)
  321.     (* initialize the relations *)
  322.     SameSizeHook := SYS.ADR (hook1);
  323.     u.InitHook (SameSizeHook, SYS.VAL (u.HookFunc, SameSize));
  324.     SameWidthHook := SYS.ADR (hook2);
  325.     u.InitHook (SameWidthHook, SYS.VAL (u.HookFunc, SameWidth));
  326.     SameHeightHook := SYS.ADR (hook3);
  327.     u.InitHook (SameHeightHook, SYS.VAL (u.HookFunc, SameHeight));
  328.   END Init;
  329.  
  330.  
  331. BEGIN
  332.   Init
  333. END EASupport.
  334.